;; Programming Languages, Homework 5

#lang racket
(require rackunit)
(require test-engine/racket-tests)

(provide (all-defined-out)) ;; so we can put tests in a second file

;; definition of structures for MUPL programs - Do NOT change
(struct var  (string) #:transparent)  ;; a variable, e.g., (var "foo")
(struct int  (num)    #:transparent)  ;; a constant number, e.g., (int 17)
(struct add  (e1 e2)  #:transparent)  ;; add two expressions
(struct ifgreater (e1 e2 e3 e4)    #:transparent) ;; if e1 > e2 then e3 else e4
(struct fun  (nameopt formal body) #:transparent) ;; a recursive(?) 1-argument function
(struct call (funexp actual)       #:transparent) ;; function call
(struct mlet (var e body) #:transparent) ;; a local binding (let var = e in body) 
(struct apair (e1 e2)     #:transparent) ;; make a new pair
(struct fst  (e)    #:transparent) ;; get first part of a pair
(struct snd  (e)    #:transparent) ;; get second part of a pair
(struct aunit ()    #:transparent) ;; unit value -- good for ending a list
(struct isaunit (e) #:transparent) ;; evaluate to 1 if e is unit else 0

;; a closure is not in "source" programs; it is what functions evaluate to
(struct closure (env fun) #:transparent) 

;; Problem 1
(define (racketlist->mupllist lst)
  (cond [(null? lst) (aunit)]
        [#t (apair (car lst) (racketlist->mupllist (cdr lst)))]))

(define (mupllist->racketlist lst)
  (cond [(aunit? lst) null]
        [#t (cons (apair-e1 lst) (mupllist->racketlist (apair-e2 lst)))]))

;; Problem 2

;; lookup a variable in an environment
;; Do NOT change this function
(define (envlookup env str)
  (cond [(null? env) (error "unbound variable during evaluation" str)]
        [(equal? (car (car env)) str) (cdr (car env))]
        [#t (envlookup (cdr env) str)]))

;; Do NOT change the two cases given to you.  
;; DO add more cases for other kinds of MUPL expressions.
;; We will test eval-under-env by calling it directly even though
;; "in real life" it would be a helper function of eval-exp.
(define (eval-under-env e env)
  (cond [(var? e) 
         (envlookup env (var-string e))]
        
        [(add? e) 
         (let ([v1 (eval-under-env (add-e1 e) env)]
               [v2 (eval-under-env (add-e2 e) env)])
           (if (and (int? v1)
                    (int? v2))
               (int (+ (int-num v1) 
                       (int-num v2)))
               (error "MUPL addition applied to non-number")))]
        
        [(ifgreater? e) 
         (let ([v1 (eval-under-env (ifgreater-e1 e) env)]
               [v2 (eval-under-env (ifgreater-e2 e) env)])
           (if (and (int? v1)
                    (int? v2))
               (if (> (int-num v1) (int-num v2))
                   (eval-under-env (ifgreater-e3 e) env)
                   (eval-under-env (ifgreater-e4 e) env)
                   )
               (begin (print v1) (print v2) (error "MUPL ifgreater applied to non-number (e1, e2)"))))]
        
        [(apair? e)
         (let ([v1 (eval-under-env (apair-e1 e) env)]
               [v2 (eval-under-env (apair-e2 e) env)])
           (apair v1 v2))]
        
        [(fst? e) 
         (let ([v1 (eval-under-env (fst-e e) env)])
           (if (apair? v1)
               (apair-e1 v1)
               (error "MUPL fst applied to non-apair")))]
        
        [(snd? e) 
         (let ([v1 (eval-under-env (snd-e e) env)])
           (if (apair? v1)
               (apair-e2 v1)
               (error "MUPL snd applied to non-apair")))]
        
        [(int? e) e]
        
        [(closure? e) e]
        
        [(aunit? e) e]
        
        [(isaunit? e) 
         (let ([v1 (eval-under-env (isaunit-e e) env)])
           (if (aunit? v1) (int 1) (int 0)))]
        
        [(fun? e)
         (let ([fname (fun-nameopt e)])
           (cond [(not (string? (fun-formal e))) (error "parameter name in fun expression is not a string")]
                 [(not (or (string? fname) (not fname))) (error "function name in fun expression is not a string/#f")]
                 [#t (closure env e)]))]
        
        [(call? e)
         (let ([c (eval-under-env (call-funexp e) env)])
           (if (closure? c)
               (let* ([f (closure-fun c)]
                      [fname (fun-nameopt f)]
                      [envWithParam (cons (cons (fun-formal f) (eval-under-env (call-actual e) env)) (closure-env c))])
                 (eval-under-env (fun-body f) (if fname 
                                                  (cons (cons fname c) envWithParam)
                                                  envWithParam)))
               (error "funexp in call expression is not a closure")
               ))]
        
        [(mlet? e)
         (let ([var (mlet-var e)])
           (if (string? var)
               (eval-under-env (mlet-body e) (cons (cons var (eval-under-env (mlet-e e) env)) env))
               (error "var name in mlet expression is not a string")))]
        ))



;; Do NOT change
(define (eval-exp e)
  (eval-under-env e null))

;; Problem 3

(define (ifaunit e1 e2 e3) (ifgreater (isaunit e1) (int 0) e2 e3))

(define (mlet* lstlst e2) 
  (if (null? lstlst) 
      e2
      (mlet (car (car lstlst)) (cdr (car lstlst)) (mlet* (cdr lstlst) e2))
      ))

(define (ifeq e1 e2 e3 e4) (mlet* (list (cons "_x" e1) (cons"_y" e2)) 
                                  (ifgreater (var "_x") (var "_y") 
                                             e4 
                                             (ifgreater (var "_y") (var "_x") 
                                                        e4 
                                                        e3))))

;; Problem 4

(define mupl-map
  (fun #f "map_func" (
                      fun "take_list_func" "lst" (ifaunit (var "lst") 
                                                          (aunit)
                                                          (apair 
                                                           (call (var "map_func") (fst (var "lst"))) 
                                                           (call (var "take_list_func") (snd (var "lst"))))
                                                          ))))

(define mupl-mapAddN 
  (mlet "map" mupl-map
        (fun #f "i" 
             (fun #f "lst"
                  (call (call 
                         (var "map") 
                         (fun #f "x" (add (var "x") (var "i")))) 
                        (var "lst"))))))


;; Challenge Problem

(struct fun-challenge (nameopt formal body freevars) #:transparent) ;; a recursive(?) 1-argument function

;; We will test this function directly, so it must do
;; as described in the assignment
(define (compute-free-vars e) "CHANGE")

;; Do NOT share code with eval-under-env because that will make
;; auto-grading and peer assessment more difficult, so
;; copy most of your interpreter here and make minor changes
(define (eval-under-env-c e env) "CHANGE")

;; Do NOT change this
(define (eval-exp-c e)
  (eval-under-env-c (compute-free-vars e) null))
